home *** CD-ROM | disk | FTP | other *** search
/ BBS in a Box 4 / BBS in a Box - Macintosh - Volume IV (January 1992) (BBS in a Box).iso / Files / Prog / M / MCLUTILS.CPT / oodles-of-utils / patches / patches.lisp / patches.lisp
Encoding:
Text File  |  1991-10-25  |  1.6 KB  |  66 lines  |  [TEXT/CCL2]
  1. (in-package :ccl)
  2. ;;;;;;;;;;
  3. ;;various patches that will eventually be standard
  4.  
  5. (export '(href hset pref pset
  6.           make-record-handle make-record-pointer
  7.           ))
  8.  
  9. ;;;;;;;;;;
  10.  
  11. ;;;;;;;;;;
  12.  
  13. (eval-when (:compile-toplevel :load-toplevel :execute)
  14.   
  15.   (defmacro href (pointer accessor)
  16.     `(rref ,pointer ,accessor :storage :handle))
  17.   
  18.   (defmacro pref (pointer accessor)
  19.     `(rref ,pointer ,accessor :storage :pointer))
  20.   
  21.   (defmacro hset (pointer accessor thing)
  22.     `(rset ,pointer ,accessor ,thing :storage :handle))
  23.   
  24.   (defmacro pset (pointer accessor thing)
  25.     `(rset ,pointer ,accessor ,thing :storage :pointer))
  26.  
  27.   )
  28.  
  29. ;;;;;;;;;;
  30.  
  31. (defmethod find-view-containing-point ((view null) h &optional v
  32.                                        (direct-subviews-only nil))
  33.   (let ((point (make-point h v)))
  34.     (flet ((check-window (w)
  35.              (when (view-contains-point-p w point)
  36.                (return-from find-view-containing-point
  37.                  (if direct-subviews-only
  38.                    w
  39.                    (find-view-containing-point
  40.                     w
  41.                     (subtract-points point (view-position w))))))))
  42.       (declare (dynamic-extent #'check-window))
  43.       (map-windows #'check-window :include-windoids t)
  44.       nil)))
  45.  
  46. ;;;;;;;;;;
  47.  
  48.  
  49. (eval-when (:compile-toplevel :load-toplevel :execute)
  50.   (require :rlet-nondestructive))
  51.  
  52. #| fixes bug illustrated below
  53.  
  54. (defrecord foo (f1 (array :integer 5)))
  55.  
  56. ;macro expands correctly
  57. (rlet ((bar :foo
  58.             (:f1 2) 99)))
  59.  
  60. ;won't compile
  61. (defun baz ()
  62.   (rlet ((bar :foo
  63.               (:f1 2) 99)))
  64.   nil)
  65.  
  66. |#